FORGET segments
 10 CONSTANT segments      \ number of snake segments
 50 CONSTANT obstacles     \ number of obstacles
152 CONSTANT wall          \ wall character
144 CONSTANT sBody         \ snake body character
 42 CONSTANT obstacle      \ obstacle character
  8 CONSTANT bGround       \ background character

CREATE charArray segments CELLS ALLOT
CREATE posArray segments CELLS ALLOT  \ segment positions
CREATE HArray segments CELLS ALLOT    \ segment horiz direction
CREATE VArray segments CELLS ALLOT    \ segment vert direction
0 VALUE segAddr  \ address of segment
0 VALUE HDir     \ segment H direction
0 VALUE VDir     \ segment V direction

1 $83D6 !      \ prevent screen blanking

HEX
CREATE wallData
  22FF , 88FF , 22FF , 88FF , 22FF , 88FF , 
CREATE BGData  
  8142 , 2418 , 1824 , 4281 , 8142 , 2418 , 1824 , 4281 ,
  
wallData VALUE wallP \ pointer to wall data
0 VALUE wallOS       \ wall data offset

BGData VALUE BGP     \ pointer to background data
0 VALUE BGOS         \ background data offset

: UDGs
  DATA 8 390F 7FFF FF7F 0F39   9CF0 FEFF FFFE F09C sBody DCHAR
  DATA 4 8040 2010 0804 0201 bGround DCHAR
  [ wall 8 * 800 + LITERAL ] wallData 8 VMBW
  [ bGround 8 * 800 + LITERAL ] BGData 8 VMBW
  ; UDGs
DECIMAL

: initColors
  18 7 0 COLOR  19 11 6 COLOR  1 13 0 COLOR ;

: border PAGE
   0 0 bGround [ 32 24 * LITERAL ] HCHAR
   0  0 wall 32 HCHAR   0 31 wall 24 VCHAR
  23  0 wall 32 HCHAR   0  0 wall 24 VCHAR ;
   
: initArrays ( -- )
  segments 0 DO 
    1  charArray I CELLS +  !
    1  HArray I CELLS +  ! 
   32  VArray I CELLS +  ! 
  LOOP ;
  
: initPos ( -- )
  segments 0 DO 33 I +  posArray I CELLS +  ! LOOP ;
  
: renderObstacles ( -- )
  19 1 DO 
    4 0 DO
      J  29 RND 1+  [ obstacle LITERAL ] 1 HCHAR 
    LOOP
  LOOP ;
  
: moveWall
  [ wall 8 * $800 + LITERAL ] wallData wallOS + 8 VMBW
  wallOS 1+ 4 MOD TO wallOS ;
  
: moveBG
  [ bGround 8 * $800 + LITERAL ] BGData BGOS + 8 VMBW
  BGOS 1+ 8 MOD TO BGOS ;
  
: moveSegments ( -- )
    segments 1- FOR
      charArray I CELLS +  @ IF
      posArray I CELLS +  TO segAddr
      HArray I CELLS + @  TO HDir
      [ bGround LITERAL ]  segAddr @  V!
      segAddr @  HDir +  V@
      DUP [ bGround LITERAL ] = IF 
        DROP  HDir segAddr +!
      ELSE
        sBody = IF
          HDir segAddr +!
        ELSE 
          HDir NEGATE  HArray I CELLS +  !
          HDir 0> IF 144 ELSE 145 THEN TO sBody
          segAddr @ [ 21 32 * 2- LITERAL ] >= IF
            VArray I CELLS +  @ TO VDir
            VDir 0> IF VDir NEGATE  VArray I CELLS +  ! THEN
          ELSE
            VArray I CELLS +  @ TO VDir
            segAddr @ [ 63 32 + LITERAL ] < IF
              VDir 0< IF VDir NEGATE  VArray I CELLS +  ! THEN
            THEN
          THEN
          VDir segAddr +!
        THEN
      THEN
      sBody  segAddr @  V!
    THEN
  NEXT ;
 
: mainLoop
  TRUE 
  BEGIN 
    moveSegments  moveWall  NOT DUP IF moveBG THEN
  0 JOYST 1 = UNTIL ;
  
: RUN ( -- )
  1 GMODE  1 SCREEN
  initColors  initPos  initArrays  border  renderObstacles   
  mainLoop  DROP ;
RUN


